home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGSCAL / XGRAPH.LZH / WEAVER.PAS < prev    next >
Pascal/Delphi Source File  |  1987-03-08  |  6KB  |  169 lines
  1. { Graphics Demo: It shows the speed of the rectangle filling routines by }
  2. { drawing ramdon size rectangle centered on the screen of different      }
  3. { pattern and color.                                                     }
  4. {                                                                        }
  5. { Written by Abe Achkinazi on August 16, 1986.                           }
  6. {                                                                        }
  7. { Permission to distribute, change, mutilate and learn from this program }
  8. { is granted.                                                            }
  9. {                                                                        }
  10. program Rectangles(input, output);
  11. label ErrorExit;
  12.  
  13. {$I Xgraph.pas }
  14.  
  15. Const
  16.   { variables defining the Omega array }
  17.   MaxOmega = 4;
  18.   Increment = 0.10;
  19.  
  20. Type
  21.   OmegaType = Record
  22.                 Amplitud : real;
  23.                 Step     : real
  24.               end;
  25.  
  26. var
  27.  
  28.     GrfData : GraphicsData;
  29.     Regs : VidRegs;
  30.  
  31.   { Frame buffer size variables }
  32.   LocMinX, LocMaxX, LocMinY, LocMaxY, CenterX, CenterY: integer;
  33.  
  34.   Omega : array[0..MaxOmega] of OmegaType;
  35.   i : integer;
  36.  
  37.   ScreenMode : integer;
  38.  
  39. function GetMode(var ScreenMode: integer):boolean;
  40. {
  41.         Function to check if a parameter was passed and if its valid.
  42. }
  43. var
  44.   Code : integer;
  45. begin
  46.   if (ParamCount < 1) or (ParamCount > 1) then GetMode := false
  47.   else begin { At least has some parameter see if its legal }
  48.     Val(ParamSTR(1), ScreenMode, Code);
  49.     if Code <> 0 then GetMode := false
  50.     else if ScreenMode in [Video320x200BW, Video320x200Color, Video640x200,
  51.        VideoEGA320x200, VideoEGA640x200, VideoEGA640x350Mono, VideoEGA640x350Color,
  52.        VideoMulti640x400, VideoMulti320x400]
  53.     then GetMode := true
  54.     else GetMode := false;
  55.   end;
  56. end; { of GetMode }
  57.  
  58. function NextValue(var OmegaVar : OmegaType; Inc : real;
  59.                    MinInt, MaxInt : integer             ):integer;
  60. var temp:real;
  61. begin
  62.   with OmegaVar do begin
  63.     temp := sin(Amplitud*Step);
  64.     Step := Step + Inc;
  65.   end;
  66.   NextValue := MinInt + round(((temp+1)/2)*(MaxInt - MinInt));
  67. end; { of NextValue }
  68.  
  69. procedure Rectangle( DeltaX, DeltaY, Pattern, Color : integer);
  70. begin
  71.   Regs.ax := VidRectFill shl 8 + Color mod 16;
  72.   Regs.cx := CenterX - DeltaX;
  73.   If Regs.cx < 0 then Regs.cx := 0;
  74.   Regs.dx := CenterY - DeltaY;
  75.   if Regs.dx < 0 then Regs.dx := 0;
  76.   Regs.si := CenterX + DeltaX;
  77.   If Regs.si > LocMaxX then Regs.si := LocMaxX;
  78.   Regs.di := CenterY + DeltaY;
  79.   If Regs.di > LocMaxY then Regs.di := LocMaxY;
  80.   Regs.es := GrfData.TextureSeg;
  81.   Regs.bx := GrfData.TextureOff + Pattern*32;
  82.   Intr(VideoInt, Regs);
  83. end; { of Rectangle }
  84.  
  85. begin { of main }
  86.  
  87.   Regs.ax := VidSetMode shl 8 + Video80x25Color; { Clear Screen in Alpha }
  88.   Intr(VideoInt, Regs);
  89.  
  90.   { Check to make sure that video extensions are installed }
  91.   Regs.ax := VidID shl 8; Regs.bx := 0; Intr(VideoInt, Regs);
  92.   if Regs.bx = 0 then begin
  93.     Writeln('Extended Graphics functions not installed.');
  94.     writeln('Hit return to exit');
  95.     readln;
  96.     goto ErrorExit;
  97.   end;
  98.  
  99.   { See if user passed legal parameter }
  100.   if not GetMode(ScreenMode) then begin
  101.     writeln('Usage: Weaver x');
  102.     writeln('where ''x'' is a legal graphics mode number from this list:');
  103.     writeln;
  104.     writeln(' 4) is CGA 320x200');
  105.     writeln(' 5) CGA 320x200');
  106.     writeln(' 6) CGA 640x200');
  107.     writeln('13) EGA 320x200');
  108.     writeln('14) EGA 640x200');
  109.     writeln('15) EGA 640x350 Monochrome');
  110.     writeln('16) EGA 640x350 Color');
  111.     writeln('20) HP-Multimode 640x400');
  112.     writeln('21) HP-Multimode 320x400');
  113.     writeln;
  114.     writeln(' Please select a mode that your video adapter and monitor');
  115.     writeln(' can use. Otherwise you might damage your equipment !');
  116.     goto ErrorExit;
  117.   end;
  118.  
  119.   { introduction }
  120.   writeln(' Graphics demo: It shows the speed of the rectangle filling routines');
  121.   writeln(' by drawing random size rectangles centered on the screen. Both the ');
  122.   writeln(' pattern and the color are also randomized.                         ');
  123.   writeln('                                                                    ');
  124.   writeln(' Written by Abe Achkinazi on August 16, 1986.                       ');
  125.   writeln('                                                                    ');
  126.   writeln(' Thanks to Peter S. Stevens and his wonderful book "Handbook of     ');
  127.   writeln(' Regular Patterns: An Introduction to Symmetry in Two Dimensions"   ');
  128.   writeln(' for providing ideas for some of the basic patterns used in the     ');
  129.   writeln(' program.                                                           ');
  130.   writeln;
  131.   writeln(' Permission to distribute, change, mutilate and learn from this        ');
  132.   writeln(' program is granted.                                                   ');
  133.   writeln('                                                                       ');
  134.   delay(3000);
  135.  
  136.     GraphInit(GrfData, ScreenMode);
  137.  
  138.   with GrfData do begin
  139.     LocMinX := MinimumX; LocMaxX := MaximumX div BitPixelDensity;
  140.     LocMinY := MinimumY; LocMaxY := MaximumY;
  141.     CenterX := (LocMaxX - LocMinX) div 2; CenterY := (LocMaxY - LocMinY) div 2;
  142.   end;
  143.  
  144.   { Initial value for Points on sinosoid }
  145.   for i := 0 to MaxOmega do with Omega[i] do begin
  146.     Amplitud := Random;
  147.     Step     := 0;
  148.   end;
  149.  
  150.   while not KeyPressed do 
  151.     Rectangle( NextValue(Omega[0], Increment, 0, CenterX), { DeltaX }
  152.              NextValue(Omega[1], Increment, 0, CenterY), { DeltaY }
  153.              NextValue(Omega[2], Increment, 0, 15),      { Pattern }
  154.              NextValue(Omega[3], Increment, 1, 15)       { Color }    );
  155.  
  156.   { ReSet Textmode }
  157.   case ScreenMode of
  158.     4, 5, 6, 13, 14, 15, 16: { Normal Int 10H mode only need to set up AX }
  159.         Regs.ax := VidSetMode shl 8 + Video80x25Color;
  160.     20, 21: begin { For multimode's extra mode must call Extended Video functs }
  161.         Regs.ax := VidExtendedFunctions shl 8 + 5; { Extended Set mode }
  162.         Regs.bx := 03; { adjust to HP's base }
  163.         end
  164.   end;
  165.   Intr(VideoInt, Regs);
  166.   
  167. ErrorExit:;     { Falls to here when there is an error }
  168. end.
  169.